home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Borland / Borland Pascal with Objects 7.0 / HELPEX.ZIP / OWLHELP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-27  |  9.9 KB  |  372 lines
  1. {************************************************}
  2. {                                                }
  3. {   Demo program                                 }
  4. {   Copyright (c) 1991 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. program HelpEx;
  9.  
  10. { ObjectWindows version of the HelpEx example program }
  11.  
  12. {$R OWLHELP.RES}
  13.  
  14. uses WinTypes, WinProcs, Strings, OWindows, ODialogs;
  15.  
  16. const
  17.   cm_Print  = 104;
  18.  
  19.   { Help Items }
  20.   cm_About        = 300;
  21.   cm_HelpIndex    = 301;
  22.   cm_HelpKeyboard = 302;
  23.   cm_HelpHelp     = 303;
  24.  
  25.   ExeNameMaxSize = 128;
  26.  
  27.   { Help contexts }
  28.   hc_EditClear = 100;
  29.   hc_EditCopy  = 101;
  30.   hc_EditCut   = 102;
  31.   hc_EditPaste = 103;
  32.   hc_EditUndo  = 104;
  33.   hc_FileExit   = 200;
  34.   hc_FileNew    = 201;
  35.   hc_FileOpen   = 202;
  36.   hc_FilePrint  = 203;
  37.   hc_FileSave   = 204;
  38.   hc_FileSaveAs = 205;
  39.   hc_EditWindow   = 300;
  40.   hc_MaximizeIcon = 301;
  41.   hc_MinimizeIcon = 302;
  42.   hc_SystemMenu   = 303;
  43.   hc_TitleBar     = 306;
  44.   hc_SizingBorder = 307;
  45.  
  46. type
  47.   THelpExApp = object(TApplication)
  48.     procedure InitMainWindow; virtual;
  49.     procedure InitInstance; virtual;
  50.   end;
  51.  
  52.   PHelpExWindow = ^THelpExWindow;
  53.   THelpExWindow = object(TWindow)
  54.     Help: Boolean;
  55.     HelpCursor: HCursor;
  56.     HelpFileName: PChar;
  57.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  58.     destructor Done; virtual;
  59.     procedure NotImplemented;
  60.     procedure WMCommand(var Message: TMessage);
  61.       virtual wm_First + wm_Command;
  62.     procedure WMLButtonDown(var Message: TMessage);
  63.       virtual wm_First + wm_LButtonDown;
  64.     procedure WMKeyDown(var Message: TMessage);
  65.       virtual wm_First + wm_KeyDown;
  66.     procedure WMSetCursor(var Message: TMessage);
  67.       virtual wm_First + wm_SetCursor;
  68.     procedure WMInitMenu(var Message: TMessage);
  69.       virtual wm_First + wm_InitMenu;
  70.     procedure WMEnterIdle(var Message: TMessage);
  71.       virtual wm_First + wm_EnterIdle;
  72.     procedure WMDestroy(var Message: TMessage);
  73.       virtual wm_First + wm_Destroy;
  74.     procedure WMNCLButtonDown(var Message: TMessage);
  75.       virtual wm_First + wm_NCLButtonDown;
  76.     procedure CMFileNew(var Message: TMessage);
  77.       virtual cm_First + cm_FileNew;
  78.     procedure CMFileOpen(var Message: TMessage);
  79.       virtual cm_First + cm_FileOpen;
  80.     procedure CMFileSave(var Message: TMessage);
  81.       virtual cm_First + cm_FileSave;
  82.     procedure CMFileSaveAs(var Message: TMessage);
  83.       virtual cm_First + cm_FileSaveAs;
  84.     procedure CMPrint(var Message: TMessage);
  85.       virtual cm_First + cm_Print;
  86.     procedure CMEditUndo(var Message: TMessage);
  87.       virtual cm_First + cm_EditUndo;
  88.     procedure CMEditCut(var Message: TMessage);
  89.       virtual cm_First + cm_EditCut;
  90.     procedure CMEditClear(var Message: TMessage);
  91.       virtual cm_First + cm_EditClear;
  92.     procedure CMEditCopy(var Message: TMessage);
  93.       virtual cm_First + cm_EditCopy;
  94.     procedure CMEditPaste(var Message: TMessage);
  95.       virtual cm_First + cm_EditPaste;
  96.     procedure CMHelpIndex(var Message: TMessage);
  97.       virtual cm_First + cm_HelpIndex;
  98.     procedure CMHelpKeyBoard(var Message: TMessage);
  99.       virtual cm_First + cm_HelpKeyBoard;
  100.     procedure CMHelpHelp(var Message: TMessage);
  101.       virtual cm_First + cm_HelpHelp;
  102.     procedure CMAbout(var Message: TMessage);
  103.      virtual cm_First + cm_About;
  104.   end;
  105.  
  106. { THelpExApp }
  107. procedure THelpExApp.InitMainWindow;
  108. begin
  109.   MainWindow := New(pHelpExWindow, Init(nil, 'HelpEx'));
  110. end;
  111.  
  112. procedure THelpExApp.InitInstance;
  113. begin
  114.   TApplication.InitInstance;
  115.   if Status = 0 then
  116.     HAccTable := LoadAccelerators(HInstance, 'HELPEXACC');
  117. end;
  118.  
  119. { THelpExWindow }
  120. constructor THelpExWindow.Init;
  121. var
  122.   FileNameLen: Integer;
  123.   FileName: array[0..ExeNameMaxSize + 1] of Char;
  124.   I: Integer;
  125. begin
  126.   { Get Menu from the Resource File }
  127.   TWindow.Init(AParent, ATitle);
  128.   Attr.Menu := LoadMenu(HInstance, 'HELPEXMENU');
  129.  
  130.   { Construct HelpFileName from Module Name }
  131.   FileNameLen := GetModuleFileName(HInstance, FileName, ExeNameMaxSize);
  132.   I := FileNameLen - 1;
  133.   while (I <> 0) and ((FileName[I] <> '\') and (FileName[I] <> ':')) do
  134.     Dec(I);
  135.   Inc(I);
  136.   if I + 13 <= ExeNameMaxSize then
  137.     StrCopy(@FileName[I], 'helpex.hlp')
  138.   else
  139.     StrCopy(@FileName[I], '?');
  140.   HelpFileName := StrNew(FileName);
  141.  
  142.   {Load the Cursor from from the Resource }
  143.   HelpCursor := LoadCursor(HInstance, 'HELPCURSOR');
  144.   Help := False;
  145. end;
  146.  
  147. destructor THelpExWindow.Done;
  148. begin
  149.   TWindow.Done;
  150.   StrDispose(HelpFileName);
  151. end;
  152.  
  153. procedure THelpExWindow.NotImplemented;
  154. begin
  155.   Messagebox(HWindow, 'Command not Implemented', 'Help Example', mb_Ok);
  156. end;
  157.  
  158. procedure THelpExWindow.WMCommand;
  159. var
  160.   HelpContextId: LongInt;
  161. begin
  162.   if Help then
  163.   begin
  164.  
  165.     { Determine the Appropriate Help Context }
  166.     case Message.wParam of
  167.       cm_FileNew: HelpContextId := hc_FileNew;
  168.       cm_FileOpen: HelpContextId := hc_FileOpen;
  169.       cm_FileSave: HelpContextId := hc_FileSave;
  170.       cm_FileSaveAs: HelpContextId := hc_FileSaveAs;
  171.       cm_Print: HelpContextId := hc_FilePrint;
  172.       cm_Exit: HelpContextId := hc_FileExit;
  173.       cm_EditUndo: HelpContextId := hc_EditUndo;
  174.       cm_EditCut: HelpContextId := hc_EditCut;
  175.       cm_EditClear: HelpContextId := hc_EditClear;
  176.       cm_EditCopy: HelpContextId := hc_EditCopy;
  177.       cm_EditPaste: HelpContextId := hc_EditPaste;
  178.     else
  179.       HelpContextId := 0;
  180.     end;
  181.  
  182.     { Warn of No Context Help Available }
  183.     { or Let the Help System take over. }
  184.     if HelpContextId = 0 then
  185.     begin
  186.       MessageBox(HWindow, 'Help not available for Help Menu Item',
  187.         'Help Example', Mb_Ok);
  188.       DefWndProc(Message);
  189.     end
  190.     else
  191.     begin
  192.       Help := False;
  193.       WinHelp(HWindow, HelpFileName, Help_Context, HelpContextId);
  194.     end;
  195.   end
  196.   else TWindow.WMCommand(Message);
  197. end;
  198.  
  199. { Handles the Press of the Left Button of the Mouse }
  200. procedure THelpExWindow.WMLButtonDown;
  201. begin
  202.   if Help then
  203.   begin
  204.     Help := False;
  205.     WinHelp(HWindow,HelpFileName, Help_Context, hc_EditWindow);
  206.   end
  207.   else DefWndProc(Message);
  208. end;
  209.  
  210. { Responds to normal keypresses }
  211. procedure THelpExWindow.WMKeyDown;
  212. begin
  213.   if Message.wParam = vk_F1 then
  214.     if GetKeyState(vk_Shift) < 0 then
  215.     begin
  216.       Help := True;
  217.       SetCursor(HelpCursor);
  218.       DefWndProc(Message);
  219.     end
  220.     else WinHelp(HWindow, HelpFileName, Help_Index, 0)
  221.   else if (Message.wParam = vk_Escape) and Help then
  222.   begin
  223.     Help := False;
  224.     SetCursor(HCursor(GetClassWord(HWindow, gcw_HCursor)));
  225.   end;
  226. end;
  227.  
  228. { Sets the Help Cursor if appropriate }
  229. procedure THelpExWindow.WMSetCursor;
  230. begin
  231.   if Help then
  232.     SetCursor(HelpCursor)
  233.   else DefWndProc(Message);
  234. end;
  235.  
  236. { Sets the Help Cursor if appropriate }
  237. procedure THelpExWindow.WMInitMenu;
  238. begin
  239.   if Help then
  240.     SetCursor(HelpCursor);
  241. end;
  242.  
  243. { Select Help during Idle }
  244. procedure THelpExWindow.WMEnterIdle;
  245. begin
  246.   if ((Message.wParam = msgf_Menu) and ((GetKeyState(vk_F1)
  247.     and $8000) <> 0)) then
  248.   begin
  249.     Help := True;
  250.     PostMessage(HWindow, wm_KeyDown, vk_Return, 0);
  251.   end;
  252. end;
  253.  
  254. { Shut Down the Help System and post Quit }
  255. procedure THelpExWindow.WMDestroy;
  256. begin
  257.   WinHelp(HWindow, HelpFileName, help_Quit, 0);
  258.   PostQuitMessage(0);
  259. end;
  260.  
  261. { Handle Help outside Client Window }
  262. procedure THelpExWindow.WMNCLButtonDown;
  263. var
  264.   HelpContextId: LongInt;
  265. begin
  266.   if Help then
  267.   begin
  268.     case Message.wParam of
  269.       htCaption: HelpContextId := hc_TitleBar;
  270.       htReduce: HelpContextId := hc_MinimizeIcon;
  271.       htZoom: HelpContextId := hc_MaximizeIcon;
  272.       htSysMenu: HelpContextId := hc_SystemMenu;
  273.       htBottom: HelpContextId := hc_SizingBorder;
  274.       htBottomLeft: HelpContextId := hc_SizingBorder;
  275.       htBottomRight: HelpContextId := hc_SizingBorder;
  276.       htTop: HelpContextId := hc_SizingBorder;
  277.       htLeft: HelpContextId := hc_SizingBorder;
  278.       htRight: HelpContextId := hc_SizingBorder;
  279.       htTopLeft: HelpContextId := hc_SizingBorder;
  280.       htTopRight: HelpContextId := hc_SizingBorder;
  281.     else
  282.       HelpContextId := 0;
  283.     end;
  284.     if HelpContextId <> 0 then
  285.     begin
  286.       Help := False;
  287.       WinHelp(HWindow, HelpFileName, Help_Context, HelpContextId);
  288.     end
  289.     else DefWndProc(Message);
  290.   end
  291.   else DefWndProc(Message);
  292. end;
  293.  
  294. procedure THelpExWindow.CMFileNew(var Message: TMessage);
  295. begin
  296.   NotImplemented;
  297. end;
  298.  
  299. procedure THelpExWindow.CMFileOpen(var Message: TMessage);
  300. begin
  301.   NotImplemented;
  302. end;
  303.  
  304. procedure THelpExWindow.CMFileSave(var Message: TMessage);
  305. begin
  306.   NotImplemented
  307. end;
  308.  
  309. procedure THelpExWindow.CMFileSaveAs(var Message: TMessage);
  310. begin
  311.   NotImplemented;
  312. end;
  313.  
  314. procedure THelpExWindow.CMPrint(var Message: TMessage);
  315. begin
  316.   NotImplemented;
  317. end;
  318.  
  319. procedure THelpExWindow.CMEditUndo(var Message: TMessage);
  320. begin
  321.   NotImplemented;
  322. end;
  323.  
  324. procedure THelpExWindow.CMEditCut(var Message: TMessage);
  325. begin
  326.   NotImplemented;
  327. end;
  328.  
  329. procedure THelpExWindow.CMEditClear(var Message: TMessage);
  330. begin
  331.   NotImplemented;
  332. end;
  333.  
  334. procedure THelpExWindow.CMEditCopy(var Message: TMessage);
  335. begin
  336.   NotImplemented;
  337. end;
  338.  
  339. procedure THelpExWindow.CMEditPaste(var Message: TMessage);
  340. begin
  341.   NotImplemented;
  342. end;
  343.  
  344. procedure THelpExWindow.CMHelpIndex(var Message: TMessage);
  345. begin
  346.   WinHelp(HWindow, HelpFileName, Help_Index, 0);
  347. end;
  348.  
  349. procedure THelpExWindow.CMHelpKeyBoard(var Message: TMessage);
  350. begin
  351.   WinHelp(HWindow, HelpFileName, Help_Key, LongInt(PChar('keys')));
  352. end;
  353.  
  354. procedure THelpExWindow.CMHelpHelp(var Message: TMessage);
  355. begin
  356.   WinHelp(HWindow, 'WINHELP.HLP', Help_Index, 0);
  357. end;
  358.  
  359. procedure THelpExWindow.CMAbout(var Message: TMessage);
  360. begin
  361.   Application^.ExecDialog(New(PDialog, Init(@Self, 'ABOUTBOX')));
  362. end;
  363.  
  364. var
  365.   HelpExApp:THelpExApp;
  366.  
  367. begin
  368.   HelpExApp.Init('HelpEx');
  369.   HelpExApp.Run;
  370.   HelpExApp.Done;
  371. end.
  372.